home *** CD-ROM | disk | FTP | other *** search
/ Games of Daze / Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso / x2ftp / msdos / source / demostuf / tweak1.pas < prev    next >
Pascal/Delphi Source File  |  1994-07-25  |  4KB  |  219 lines
  1. UNIT TWEAK1;
  2. {
  3.     Converts IFF/ILBM image file with format 320*200 in 256 colours with
  4.     packed colours to a raw image - but bonus-tweak-vga raw image...
  5.  
  6.   THIS PROGRAM WAS CODED BY BJARKE VIKS0E.
  7.   YOU ARE FREE TO DO WHATEVER YOU WANT WITH THIS PIECE OF CODE.
  8.   E-MAIL ME AT: dat92230@rix02.lyngbyes.dk IN 1994 FOR CHAT AND CODE.
  9. }
  10.  
  11. INTERFACE
  12.  
  13. uses
  14.     DEMOINIT;
  15.  
  16. type
  17.     pIFFBuffer = ^IFFbuffertype;
  18.     IFFbuffertype = array[1..65528] of byte;
  19.     filestring = string[30];
  20.  
  21. var
  22.     cmap : array[1..256*3] of byte;
  23.  
  24. procedure LoadPix(p : pScreen; filename : filestring);
  25. procedure ConvertIFF(p : pScreen; v : pIFFBuffer);
  26. procedure SetCMAP;
  27. procedure Copy2Screen(v : pScreen; s : pScreen);
  28. procedure FadeCMAP(faktor : integer);
  29.  
  30.  
  31. IMPLEMENTATION
  32.  
  33. var
  34.     n,d : word;
  35.  
  36.  
  37. procedure IFFcmap(v : pIFFBuffer; i, clength : longint);
  38. var
  39.     r,g,b : byte;
  40.     j,k : integer;
  41. begin
  42.     k:=1;
  43.     for j:=0 to (clength DIV 3)-1 do begin
  44.         r:=v^[i] div 4; g:=v^[i+1] div 4; b:=v^[i+2] div 4;
  45.         inc(i,3);
  46.         cmap[k]:=r; cmap[k+1]:=g; cmap[k+2]:=b;
  47.         inc(k,3);
  48.     end;
  49.     cmap[1]:=0; cmap[2]:=0; cmap[3]:=0;
  50. end;
  51.  
  52. procedure IFFfindPos; assembler;
  53. asm
  54.     mov    ax,d
  55.     cmp    ax,0
  56.     jne    @not1
  57.     mov    ax,(320*200/4)
  58.     jmp    NEAR PTR @ok
  59. @not1:
  60.     cmp    ax,(320*200/4)
  61.     jne    @not2
  62.     mov    ax,(320*200/4)*2
  63.     jmp    NEAR PTR @ok
  64. @not2:
  65.     cmp    ax,(320*200/4)*2
  66.     jne    @not3
  67.     mov    ax,(320*200/4)*3
  68.     jmp    NEAR PTR @ok
  69. @not3:
  70.     cmp    ax,(320*200/4)*3
  71.     jne    @ok
  72.     xor    ax,ax
  73.     inc    n
  74. @ok:
  75.     mov    d,ax
  76. end;
  77.  
  78.  
  79. procedure IFFbody(p : pScreen; v : pIFFBuffer; i : longint; VAR done : boolean);
  80. var
  81.     x : word;
  82.     c : shortint;
  83.     fill : byte;
  84. begin
  85.     x:=0;
  86.     n:=0;            { actual offset }
  87.     d:=0;            { pointer to which of the 4 buffers we are printing in... }
  88.  
  89.     repeat
  90.         c:=v^[i]; inc(i);
  91.         if (c < 0) then begin
  92.             c:=-c;
  93.             fill:=v^[i]; inc(i);
  94.             for x:=x to x+c do begin
  95.                 p^[n+d]:=fill;
  96.                 IFFfindPos;
  97.             end;
  98.         end
  99.         else begin
  100.             for x:=x to x+c do begin
  101.                 p^[n+d]:=v^[i];
  102.                 inc(i);
  103.                 IFFfindPos;
  104.             end;
  105.         end;
  106.     until (n >= WIDTH*200);
  107.  
  108.     done:=TRUE;
  109. end;
  110.  
  111.  
  112. procedure ConvertIFF(p : pScreen; v : pIFFBuffer);
  113. var
  114.     i : longint;
  115.     done : boolean;
  116.     flength : longint;
  117.     clength : longint;
  118.     chunkname : string[4];
  119. begin
  120.     if (char(v^[1])<>'F') AND (char(v^[2])<>'O') AND (char(v^[3])<>'R') AND (char(v^[4])<>'M') then halt;
  121.     flength:=v^[5] shl 8;
  122.     inc(flength,v^[6]); flength:=flength shl 8;
  123.     inc(flength,v^[7]); flength:=flength shl 8;
  124.     inc(flength,v^[8]);
  125.     if (char(v^[9])<>'P') AND (char(v^[10])<>'B') AND (char(v^[11])<>'M') AND (char(v^[12])<>' ') then halt;
  126.  
  127.     i:=13;
  128.     done:=FALSE;
  129.  
  130.     repeat
  131.         chunkname:=concat(char(v^[i]),char(v^[i+1]),char(v^[i+2]),char(v^[i+3]));
  132.         inc(i,4);
  133.  
  134.         clength:=v^[i] shl 8;
  135.         inc(clength,v^[i+1]); clength:=clength shl 8;
  136.         inc(clength,v^[i+2]); clength:=clength shl 8;
  137.         inc(clength,v^[i+3]);
  138.         if ((clength and 1) <> 0) then inc(clength);
  139.         inc(i,4);
  140.  
  141.         if (chunkname='CMAP') then IFFcmap(v, i,clength);
  142.         if (chunkname='BODY') then IFFbody(p,v, i,done);
  143.         inc(i,clength);
  144.     until (i > flength) OR done;
  145. end;
  146.  
  147.  
  148. procedure LoadPix(p : pScreen; filename : filestring);
  149. var
  150.     pFileMem: pIFFBuffer;
  151.     FileHandle : file;
  152.     size : longint;
  153. begin
  154.     Assign(FileHandle, filename);
  155.     Reset(FileHandle, 1);
  156.     size := filesize(FileHandle);
  157.     GetMem(pFileMem, size);
  158.     BlockRead(FileHandle, pFileMem^, size);
  159.     Close(FileHandle);
  160.     ConvertIFF(p, pFileMem);
  161.     FreeMem(pFileMem, size);
  162. end;
  163.  
  164.  
  165. (*--------------------------------------*)
  166.  
  167. procedure SetCMAP;
  168. var
  169.     i,j : integer;
  170. begin
  171.     j:=1;
  172.     for i:=0 to 255 do begin
  173.         SetRGB(i,cmap[j],cmap[j+1],cmap[j+2]);
  174.         inc(j,3);
  175.     end;
  176. end;
  177.  
  178. procedure CopyPlane(v : pScreen; s : pScreen); assembler;
  179. asm
  180.     push    ds
  181.     lds    si,v
  182.     les    di,s
  183.     cld
  184.     mov    cx,80*200/2
  185.     rep movsw
  186.     pop    ds
  187. end;
  188.  
  189. procedure Copy2Screen(v : pScreen; s : pScreen);
  190. const
  191.     size = 80*200;
  192. begin
  193.     SetBitplanes(1);
  194.     CopyPlane(@v^[0],s);
  195.     SetBitplanes(2);
  196.     CopyPlane(@v^[size],s);
  197.     SetBitplanes(4);
  198.     CopyPlane(@v^[size*2],s);
  199.     SetBitplanes(8);
  200.     CopyPlane(@v^[size*3],s);
  201. end;
  202.  
  203.  
  204. procedure FadeCMAP(faktor : integer);
  205. var
  206.     i,j : integer;
  207. begin
  208.     VBLANK;
  209.     j:=1;
  210.     for i:=0 to 255 do begin
  211.         SetRGB(i,
  212.                 longmul(cmap[j],faktor) shr 8,
  213.                 longmul(cmap[j+1],faktor) shr 8,
  214.                 longmul(cmap[j+2],faktor) shr 8);
  215.         inc(j,3);
  216.     end;
  217. end;
  218.  
  219. end.